Turnbull China Bikeride/Turnbull China Bikeride - Disc 2.iso/BARNET/COMPILER/SATHER/!Sather/Library/Containrs/sa/set_incl

Text File | 1996-07-13 | 12KB | 343 lines

---------------------------> Sather 1.1 source file <--------------------------
-- set_incl.sa: Set include partial classes
-- Author: Benedict A. Gomes <[e-mail]>
-- Copyright (C) 1995, International Computer Science Institute
-- $Id: set_incl.sa,v 1.10 1996/07/13 05:41:11 gomes Exp $
--
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
-------------------------------------------------------------------
partial class RO_SET_INCL{E} < $RO_SET{E} is
   -- Partial class for $RO_SET{E} that implements other functions
   -- in terms of has and elt!
   --
   private include COMPARE{E};

   stub has(e: E): BOOL;
   -- Return true if the class has the element "e"

   stub elt!: E;
   -- Yield the elements of the set

   stub copy: SAME;
   -- Return a copy of the set

   private create_from_internal(s: $RO_SET{E}): SET{E} is
      -- Used as an auxilliary routine by the view creation routines.
      -- When the return type can be any $RO_SET, then by default a
      -- "SET" will be constructed and used
      return #SET{E}(s);
   end;

   --              ------ Access/Measurement -------------
   size: INT is
      i ::= 0; loop discard ::= elt!; i := i + 1; end;
      return i;
   end;

   is_empty: BOOL pre ~void(self) is
      -- Do not do size=0. Finding size may require iteration
      -- through all elements - quite wasteful for just "is_empty"
      loop e ::= elt!; return false; end;
      return true;
   end;

   --              ------ Queries/Comparison --------------
   equals(a:$RO_SET{E}): BOOL     pre ~void(self) and ~void(a)   is
      -- Returns 'true' if every element of self is elt_eq to
      -- an element in 'a' and vice versa.
      -- Neither may be void.
      if a.size /= size then return false end;
      loop e ::= a.elt!;
     if ~has(e) then   return false end
      end;
      -- The second loop could be replaced against
      -- 'return size = a.size' but this won't work for
      -- some types of elements.
      loop if ~a.has(elt!) then   return false; end  end;
      return true
    end;

   --              ------ Conversion ----------------------
   as_array: ARRAY{E} is
      res ::= #ARRAY{E}(size);
      loop res.set!(elt!) end;
      return res;
   end;

   str: STR is
      -- Prints out a string version of the array of the components
      -- that are under $STR
      res ::= #FSTR("{");
      loop  e ::= elt!;
     typecase e
     when $STR then res := res+",".separate!(e.str);
     else res := res+",".separate!("unprintable"); end;
      end;
      res := res + "}";
      return(res.str);
   end;

   --              ------ Basic Operations ----------------
   union(s: $RO_SET{E}): SET{E} is
      -- Union is defined by default to create a "view" and then convert
      -- that into a SET.  Subtypes may redefine this behavior to return
      -- a set of type "SAME", without going through a view
      return create_from_internal(union_view(s));
   end;

   intersection(s:$RO_SET{E}): SET{E} is
      -- See the comment for "union" and $RO_SET::intersection
      return create_from_internal(intersection_view(s))
   end;

   diff(s: $RO_SET{E}): SET{E} is
      -- See the comment for "union" and $RO_SET::diff
      return create_from_internal(diff_view(s))
   end;

   sym_diff(s: $RO_SET{E}): SET{E} is
      -- See the comment for "union" and $RO_SET::sym_diff
      return create_from_internal(sym_diff_view(s))
   end;

   union_view(s: $RO_SET{E}): $RO_SET{E} is
      -- Return a read-only "view" of the union of "self" and "s"
      -- The resulting view just points to the two component sets
      -- and computes its elements on-the-fly, as needed.
      -- As a result, this form of union requires almost no
      -- additional space but may it may take slightly longer to
      -- perform operations
      return BINOP_SET_VIEW{E}::create_union(get_set_of_self,s);
   end;

   intersection_view(s: $RO_SET{E}): $RO_SET{E} is
      -- See the note for "union_view"
      return BINOP_SET_VIEW{E}::create_intersection(get_set_of_self,s);
   end;

   diff_view(s: $RO_SET{E}): $RO_SET{E} is
      -- See the comment for "union_view"
      return BINOP_SET_VIEW{E}::create_diff(get_set_of_self,s);
   end;

   sym_diff_view(s: $RO_SET{E}): $RO_SET{E} is
      -- See the comment for "union_view"
      return BINOP_SET_VIEW{E}::create_sym_diff(get_set_of_self,s);
   end;

   is_subset_of(s: $RO_SET{E}): BOOL is
      -- Return true if "self" is a subset of "s"
      return diff_view(s).is_empty
   end;

   private get_set_of_self: SAME is
      local_self ::= self;
      typecase local_self
      when $RO_SET{E} then return local_self
      else
     raise("Partial RO_SET_INCL included in a non-subtype of $RO_SET");
      end;
   end;

end;
-------------------------------------------------------------------
partial class SET_INCL{E} < $SET{E} is
    -- SET_INCL defines some of the set functions which are not dependant
    -- on the implementation of the set.
    -- The most common routines (union, intersect etc.) are special cased
    -- so that when the argument is of type SAME there is no dispatching.
    -- Be careful about create
   include RO_SET_INCL{E};

   stub insert(e:E);
   -- Insert element "e" into the set

   stub delete(e:E);
   -- Delete element "e" from the set

   stub create: SAME;
   -- Create an empty set - used by the other set create routines

   --              ------ Initialization/Duplication ------
   create(a: ARRAY{E}): SAME is
      return create_from(a);
   end;

   create_from(e: $ELT{E}): SAME is
      res ::= create;
      loop res.insert(e.elt!) end;
      return res;
   end;

   copy_from(a: $ELT{E}) is
      -- Clear old elts and insert the elements of self
      clear;
      loop insert(a.elt!) end;
   end;

   clear is
      -- Expensive! To make sure that we don't overwrite while
      -- reading, use a seperate array.
      elts: FLIST{E} := #;
      loop elts := elts.push(elt!) end;
      loop delete(elts.elt!) end;
   end;

   --              ------ Basic Operations ----------------
   -- Versions that modify self, special cased when the arg is SAME
   to_union(a: $ELT{E}) pre ~void(self) and ~void(a) is
      typecase a
      when SAME then
     loop e ::= a.elt!; if ~has(e) then insert(e) end end;
      else loop e ::= a.elt!; if ~has(e) then insert(e) end end; end;
   end;

   to_diff(a: $ELT{E}) pre ~void(self) and ~void(a) is
      typecase a
      when SAME then loop e ::= a.elt!; if has(e) then delete(e) end  end;
      else loop e ::= a.elt!; if has(e) then delete(e) end  end; end;
   end;

   to_sym_diff(a: $ELT{E}) pre ~void(self) and ~void(a) is
      typecase a
      when SAME then
     loop e::=a.elt!; if has(e) then delete(e) else insert(e) end end;
      else
     loop e::=a.elt!; if has(e) then delete(e) else insert(e) end end;
      end;
   end;

   to_intersection(a: $ELT{E}) is
      typecase a
      when SAME then
     loop e ::= a.elt!; if ~has(e) then delete(e) end; end;
      else loop e ::= a.elt!; if ~has(e) then delete(e) end; end; end;
   end;

end; -- SET_INCL{E}
-------------------------------------------------------------------
class BINOP_SET_VIEW{ETP} < $RO_SET{ETP} is
   -- View of a binary operation between two sets.
   -- Handles union, intersection, diff and sym_diff
   -- Instead of copying the sets, it merely maintains pointers
   -- to the two sets.
   -- This view is read-only and *cannot* be used to modify the
   -- original sets. Note that it is *not* a value interface.
   -- In fact, if the original sets change, this view will automatically
   -- change. In some cases this is exactly the behavior you want;
   -- in other cases it can be a source of nasty problems. Use carefully.
   --
   -- Usage:
   --     s1: $SET{INT} := #SET{INT}(|1,2,3,5|);
   --     s2: $SET{INT} := #SET{INT}(|1,5,3,9|);
   --     s ::= BINOP_SET_VIEW{INT}::create_union(s1,s2);
   --     #OUT+ s.str;
   --      -- will print out the elements 1,2,3,5,9 in some arbitrary order
   --     s2.delete(9);
   --     #OUT+s.str;
   --      -- will print out the elements 1,2,3,5 in some arbitrary order
   --
   -- Implementation:
   --     Maintains pointers to the two sets, primary and secondary
   --     The space of the final set is broken down into:
   --     Primary set: (       primary               )
   --     Seconary set:               (          secondary         )
   --     Result:      ( p_minus_s    ( intersection )  s_minus_p  )
   --
   --     The flags use_p_minus_s, use_intersect and use_s_minus_p indicate
   --     which part should be used
   include RO_SET_INCL{ETP};

   private attr primary: $RO_SET{ETP};
   private attr secondary: $RO_SET{ETP};
   private attr use_p_minus_s: BOOL; -- Use elements in prim-sec
   private attr use_intersect: BOOL;    -- Use elements in prim intersect sec
   private attr use_s_minus_p: BOOL;    -- Use elements in sec - prim

   create_union(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
      return #(prim,sec,true,true,true);
   end;

   create_intersection(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
      return #(prim,sec,false,true,false);
   end;

   create_diff(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
      return #(prim,sec,true,false,false);
   end;

   create_sym_diff(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
      return #(prim,sec,true,false,true);
   end;

   create(prim: $RO_SET{ETP}, sec: $RO_SET{ETP},
      use_p_minus_s: BOOL,use_intersect:BOOL, use_s_minus_p: BOOL): SAME
   -- The three parameters indicate whether the resulting set should
   -- contain
   -- (a) elements from A-B
   -- (b) elements from A intersection B
   -- (c) elements from B-A
   -- A-B  A in B  B-A
   --  f      f     f = empty
   -- *f      f     t = B-A
   -- *f      t     f = intersection
   --  f      t     t = B
   -- *t      f     f = A - B
   -- *t      f     t = Symmetric Difference
   --  t      t     f = A
   -- *t      t     t = A union B
   -- The combinations marked with asterisks are the interesting combinations.
   -- This class was designed thus so as to generate the different interesting
   -- views of a set using a single class rather than creating separate
   -- view classes which generates much more code.
      pre ~void(prim) and ~void(sec)
   is
      res ::= new;
      res.primary := prim;
      res.secondary := sec;
      res.use_p_minus_s := use_p_minus_s;
      res.use_intersect := use_intersect;
      res.use_s_minus_p := use_s_minus_p;
      return res;
   end;

   copy: SAME is
      -- Copy returns a copy of the same type of set
      return #SAME(primary,secondary,use_p_minus_s,use_intersect,use_s_minus_p)
   end;

   has(e: ETP): BOOL is
      -- Return true if "e" belongs to this set
      -- ph = primary has e  sh = secondary has e
      -- * indicates a don't care
      -- ph sh                       p-s  p in s  s-p
      -- T   T  => result is True if  *      t     *
      -- T   F  => result is True if  t      *     *
      -- F   T  =>           True if  *      *     t
      -- F   F  => result is False
      ph ::= primary.has(e);  sh ::= secondary.has(e);
      return (ph and sh and use_intersect)
        or (ph and use_p_minus_s)
        or (sh and use_s_minus_p)
   end;

   elt!: ETP is
      if use_p_minus_s and use_intersect then
     loop e ::= primary.elt!; yield e end;
      elsif use_p_minus_s and ~use_intersect then
     loop e ::= primary.elt!; if ~secondary.has(e) then yield e end end;
      elsif ~use_p_minus_s and use_intersect then
     loop e ::= primary.elt!; if secondary.has(e) then yield e end; end;
      end;
      if use_s_minus_p then
     loop e ::= secondary.elt!; if ~primary.has(e) then yield e end; end;
      end;
   end;

end;
-------------------------------------------------------------------